home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 40
/
040.d81
/
join four
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
4KB
|
128 lines
1 gosub 6000
4 sp$="[145] "
5 vv=54296:ww=54276:aa=54277:hf=54273:lf=54272:ss=54278:ph=54275:pl=54274
20 print"[147]enter 1st player (return-aborts)":print"name [154]:[152]";:gosub8000
21 ifa$="" then print"":gosub 690:printsp$:goto 20
24 pl$(1)=a$
30 print"enter 2nd player (return-aborts)"
31 print"name [154]:[152] [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";:gosub8000
32 ifa$="" then print"":gosub 690:printsp$:goto 30
34 pl$(2)=a$
35 tr=0:tu=1:pl(1)=81:pl(2)=87:pt(1)=2 :pt(2)=7 :cq=1
40 print"[147]";:print"";:poke 53281,0:poke53280,0
50 print"[156] [154] j o i n f o u r"
60 print" [156] by"
70 print" kenneth scott allen"
75 print" [152] four in a row is a win"
80 print"[155]1234567"
90 print"[176][192][178][192][178][192][178][192][178][192][178][192][178][192][174]"
100 for x=1 to 6
110 print"[221][160][221][160][221][160][221][160][221][160][221][160][221] [221]"
120 print"[171][192][219][192][219][192][219][192][219][192][219][192][219][192][179]"
130 next x
140 print"[145][173][192][177][192][177][192][177][192][177][192][177][192][177][192][189]"
150 data 1315,1317,1319,1321,1323,1325,1327
160 data 1395,1397,1399,1401,1403,1405,1407
170 data 1475,1477,1479,1481,1483,1485,1487
180 data 1555,1557,1559,1561,1563,1565,1567
190 data 1635,1637,1639,1641,1643,1645,1647
200 data 1715,1717,1719,1721,1723,1725,1727
210 for x=1 to 6:for y=1 to 7:read a(x,y):next:next
220 cq=cq+1:printco$(tu);"[154]enter move player";tu
224 if a$<>"" then poke 198,0
225 get a$:mo=val(a$):if mo>7 or mo<1 then 224
230 co=mo:if peek(a(1,mo))<>96 and peek(a(1,mo))<>32 then220
240 for l=1 to 6
250 poke a(l,mo),pl(tu):poke a(l,mo)+54272,pt(tu)
260 if l>1 then poke a(l-1,mo),96
270 ifpeek(a(l+1,mo))<>96andpeek(a(l+1,mo))<>32thenpo=l:l=7:cr=mo:gosub350
280 next l
290 if tr=41 then330
300 tr=tr+1
310 if tu=1 then tu=2:goto220
320 if tu=2 then tu=1:goto220
330 print"[147]":print"board is full":goto660
350 f1=0:for pr=po to po+3:if peek(a(pr,mo))<>pl(tu) then pr=po+3:f1=1
360 next:if f1<>1 then mm=1: goto650
380 pq=0:pt=cr:f1=0:for pr=po to po-3 step-1:pq=pq+1
390 if peek(a(pr,pt+(pq-1)))<>pl(tu) then pr=po-3:f1=1
400 next:if f1<>1 then mm=2: goto650
420 ifco<4then480
425 pw=0:f1=0:pt=cr:for pr=po to po+3:pw=pw+1
430 if pt-(pw-1)>0 then pz=pt-(pw-1)
435 rem print" ": print"[145]"a(pr,pz),pr,pz
440 if peek(a(pr,pz))<>pl(tu) then pr=po+3:f1=1
450 next:if f1<>1 then mm=3: goto650
460 if pw+pq=7 then650
470 rem right
480 pw=0:pq=0:f1=0:forpt=motomo+3:ifpeek(a(po,pt))<>pl(tu)thenpt=mo+3:f1=1
490 pq=pq+1:next:if f1<>1 then mm=4: goto650
510 f1=0:forpt=motomo-3 step-1:if peek(a(po,pt))<>pl(tu) then pt=mo-3:f1=1
520 pw=pw+1:next:if f1<>1 then mm=5: goto650
530 if pw+pq=7 then650
540 rem right down
550 pq=0:pt=cr:f1=0:for pr=po to po+3:pq=pq+1
560 if peek(a(pr,pt+(pq-1)))<>pl(tu) then pr=po+4:pt=mo+3:f1=1
570 next:if f1<>1 then mm=6: goto650
590 pw=0:pt=cr:f1=0:for pr=po to po-3 step-1:pw=pw+1
600 if pt-(pw-1)>0 then pz=pt-(pw-1)
610 if peek(a(pr,pz))<>pl(tu) then pr=po-3:f1=1
620 next:if f1<>1 then mm=7: goto650
630 if pw+pq=7 then650
640 return
650 gosub 800:printpl$(tu)" won"
660 print"do you want to play again (y/n)"
670 get ye$:if ye$="" then670
680 if ye$="y" then restore:goto 700
683 if ye$="n" then gosub690:goto5
685 goto 670
690 print"[145] do you wish to quit? (y/n) "
691 geta$:ifa$="y"ora$="[217]"then695
692 ifa$="n"ora$="[206]"then return
693 goto 691
695 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
696 ifer<>63 thenprint"[147]":end
697 load"hello connect",8,1
700 print"[147]are these the same players (y/n)"
701 get ans$:if ans$="" then 701
710 if ans$="y" then 35
730 if ans$="n" then 20
740 goto 701
800 pokevv,15:pokeaa,88: poke ph,15:poke pl,15:pokess,89 :for ee=1 to 6
805 poke hf,31:pokelf,164:pokeww,65
810 for t=1 to 150:next:pokeww,64:nextee:return
6000 poke53280,.:poke53281,.
6010 printchr$(142)"[147][146] [158]l o a d s t a r"
6020 print" [152][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
6021 print" [156]presents"
6030 print"[176]{$60}[178]{$60}[178]{$60}[178]{$60}[178]{$60}[178]{$60}[178]{$60}[178]{$60}[178]{$60}[178]{$60}[178]{$60}[178]{$60}[178]{$60}[178]{$60}[178]{$60}[178]{$60}[178]{$60}[178]{$60}[178]{$60}[174]"
6040 print"{$7d}[160]{$7d} {$7d} {$7d} {$7d} {$7d} {$7d} {$7d} {$7d} {$7d}[158]W{$7d} {$7d} {$7d} {$7d}Q{$7d}Q{$7d} {$7d} {$7d} {$7d} {$7d}"
6050 print"[171]{$60}{$7b}{$60}{$7b}[154] [151][146]{$60}{$7b}{$60}[179]"
6060 print"{$7d} {$7d}[158]W{$7d}[154] j o i n f o u r [146] {$7d} {$7d}"
6070 print"[171]{$60}{$7b}{$60}{$7b}[154] [151][146]{$60}{$7b}{$60}[179]"
6080 print"{$7d}[160]{$7d}Q{$7d}[154] by kenneth s. allen [146] {$7d}[158]W{$7d}"
6090 print"[171]{$60}{$7b}{$60}{$7b}[154] [151][146]{$60}{$7b}{$60}[179]"
6100 print"{$7d}Q{$7d}Q{$7d}[158]W[151]{$7d} {$7d} {$7d} {$7d}[160][151]{$7d}Q{$7d} {$7d}W{$7d} {$7d} {$7d}W{$7d} {$7d} {$7d}Q{$7d}[160][151]{$7d}W{$7d}Q{$7d}"
6110 print"[171]{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}{$7b}{$60}[179]"
6120 print"{$7d}Q{$7d}Q{$7d}Q{$7d}[158]W{$7d} {$7d}Q{$7d}Q{$7d}[158]W{$7d} {$7d}Q{$7d}[158]W{$7d}[158]W{$7d}Q{$7d}[158]W{$7d} {$7d}Q{$7d}[158]W{$7d}Q";
6130 print"{$7d}[158]W{$7d}"
6140 print"[173]{$60}[177]{$60}[177]{$60}[177]{$60}[177]{$60}[177]{$60}[177]{$60}[177]{$60}[177]{$60}[177]{$60}[177]{$60}[177]{$60}[177]{$60}[177]{$60}[177]{$60}[177]{$60}[177]{$60}[177]{$60}[177]{$60}[189]"
6150 print
6180 print
6190 print
6200 print" copyright [153]1987"
6210 print
6220 print
6230 print" press [150]space to continue"
6260 geta$:ifa$<>" "then6260
6275 return
8000 a$="":print"[164]";:forx=1to26
8010 getb$:ifb$=""then8010
8012 ifb$=chr$(20)andx>1 then x=x-1:printb$;"[157][164]";:a$=left$(a$,x-1):goto8010
8020 ifb$=chr$(20)then8010
8025 ifb$=chr$(13)thenprint"[157] ":return
8030 ifb$<" " then8010
8032 ifb$>"z"andb$<"[193]"orb$>"[218]"then8010
8035 ifx>15 then 8010
8040 a$=a$+b$:print"[157]";b$;"[164]";:next